home *** CD-ROM | disk | FTP | other *** search
/ IRIS Performer 2.2 Friends Demo / SGI IRIS Performer 2.2 Friends Demo.iso / friends / openworlds / tix / FileBox.tcl < prev    next >
Text File  |  1997-11-22  |  14KB  |  555 lines
  1. # ToDo
  2. #   (1)    If user has entered an invalid directory, give an error dialog
  3. #
  4.  
  5. tixWidgetClass tixFileSelectBox {
  6.     -superclass tixPrimitive
  7.     -classname  TixFileSelectBox
  8.     -method {
  9.     filter invoke
  10.     }
  11.     -flag {
  12.     -browsecmd -command -dir -directory -disablecallback
  13.     -grab -pattern -selection -value
  14.     }
  15.     -configspec {
  16.     {-browsecmd browseCmd BrowseCmd {}}
  17.     {-command command Command {}}
  18.     {-directory directory Directory {}}
  19.     {-disablecallback disableCallback DisableCallback false}
  20.     {-grab grab Grab global}
  21.     {-pattern pattern Pattern *}
  22.     {-value value Value {}}
  23.     }
  24.     -alias {
  25.     {-selection -value}
  26.     {-dir -directory}
  27.     }
  28.     -forcecall {
  29.     -value
  30.     }
  31.     -default {
  32.     {.relief            raised}
  33.     {*filelist*Listbox.takeFocus    true}
  34.     {.borderWidth             1}
  35.     {*Label.anchor            w}
  36.     {*Label.borderWidth        0}
  37.     {*Label.font                   -Adobe-Helvetica-Bold-R-Normal--*-120-*}
  38.     {*TixComboBox*scrollbar        auto}
  39.     {*TixComboBox*Label.anchor    w}
  40.     {*TixScrolledListBox.scrollbar    auto}
  41.     {*Listbox.exportSelection    false}
  42.     {*Listbox.exportSelection    false}
  43.     }
  44. }
  45.  
  46. option add *TixFileSelectBox*directory*Label.text  "Directories:"
  47. option add *TixFileSelectBox*directory*Label.underline 0
  48. option add *TixFileSelectBox*file*Label.text  "Files:"
  49. option add *TixFileSelectBox*file*Label.underline 2
  50.  
  51. option add *TixFileSelectBox*filter.label "Filter:"
  52. option add *TixFileSelectBox*filter*label.underline 3
  53. option add *TixFileSelectBox*filter.labelSide top
  54.  
  55. option add *TixFileSelectBox*selection.label "Selection:"
  56. option add *TixFileSelectBox*selection*label.underline 0
  57. option add *TixFileSelectBox*selection.labelSide top
  58.  
  59. proc tixFileSelectBox::InitWidgetRec {w} {
  60.     upvar #0 $w data
  61.     global env
  62.  
  63.     tixChainMethod $w InitWidgetRec
  64.  
  65.     if {$data(-directory) == {}} {
  66.     global env
  67.  
  68.     if {[info exists env(PWD)]} {
  69.         set data(-directory) $env(PWD)
  70.     } else {
  71.         set data(-directory) [pwd]
  72.     }
  73.     }
  74.  
  75.     set data(flag)      0
  76.     set data(fakeDir)   0
  77. }
  78.  
  79.  
  80. proc tixFileSelectBox::SetBindings {w} {
  81.     upvar #0 $w data
  82.  
  83.     tixChainMethod $w SetBindings
  84.  
  85.     tixDoWhenMapped $w "tixFileSelectBox::FirstMapped $w"
  86.  
  87.     $data(w:dirlist) config \
  88.     -browsecmd "tixFileSelectBox::SelectDir $w" \
  89.     -command   "tixFileSelectBox::InvokeDir $w"
  90.  
  91.     $data(w:filelist) config \
  92.     -browsecmd "tixFileSelectBox::SelectFile $w" \
  93.     -command   "tixFileSelectBox::InvokeFile $w"
  94. }
  95.  
  96. #----------------------------------------------------------------------
  97. #        Construct widget
  98. #----------------------------------------------------------------------
  99. proc tixFileSelectBox::ConstructWidget {w} {
  100.     upvar #0 $w data
  101.  
  102.     tixChainMethod $w ConstructWidget
  103.  
  104.     set frame1 [tixFileSelectBox::CreateFrame1 $w]
  105.     set frame2 [tixFileSelectBox::CreateFrame2 $w]
  106.     set frame3 [tixFileSelectBox::CreateFrame3 $w]
  107.  
  108.     pack $frame1 -in $w -side top -fill x
  109.     pack $frame3 -in $w -side bottom -fill x
  110.     pack $frame2 -in $w -side top -fill both -expand yes
  111.  
  112.     tixSetSilent $data(w:filter) \
  113.     [tixFileSelectBox::GetFilter $w $data(-directory) $data(-pattern)]
  114.  
  115.     $data(w:filter) addhistory \
  116.     [tixFileSelectBox::GetFilter $w $data(-directory) $data(-pattern)]
  117. }
  118.  
  119. proc tixFileSelectBox::CreateFrame1 {w} {
  120.     upvar #0 $w data
  121.  
  122.     frame $w.f1 -border 10
  123.     tixComboBox $w.f1.filter -history true\
  124.     -command "$w filter" -anchor e \
  125.     -options {
  126.         slistbox.scrollbar auto
  127.         listbox.height 5
  128.         label.anchor w
  129.     }
  130.     set data(w:filter) $w.f1.filter
  131.  
  132.     pack $data(w:filter) -side top -expand yes -fill both
  133.     return $w.f1
  134. }
  135.  
  136. proc tixFileSelectBox::CreateFrame2 {w} {
  137.     upvar #0 $w data
  138.  
  139.     tixPanedWindow $w.f2 -orientation horizontal
  140.     #     THE LEFT FRAME
  141.     #-----------------------
  142.     set dir [$w.f2 add directory -size 120]
  143.     $dir config -relief flat
  144.     label $dir.lab
  145.     set data(w:dirlist) [tixScrolledListBox $dir.dirlist\
  146.                -scrollbar auto\
  147.                -options {listbox.width 4 listbox.height 6}]
  148.  
  149.     pack $dir.lab -side top -fill x -padx 10
  150.     pack $data(w:dirlist) -side bottom -expand yes -fill both -padx 10
  151.  
  152.     #     THE RIGHT FRAME
  153.     #-----------------------
  154.     set file [$w.f2 add file -size 160]
  155.     $file config -relief flat
  156.     label $file.lab
  157.     set data(w:filelist) [tixScrolledListBox $file.filelist \
  158.                -scrollbar auto\
  159.                -options {listbox.width 4 listbox.height 6}]
  160.  
  161.     pack $file.lab -side top -fill x -padx 10
  162.     pack $data(w:filelist) -side bottom -expand yes -fill both -padx 10
  163.  
  164.     return $w.f2
  165. }
  166.  
  167. proc tixFileSelectBox::CreateFrame3 {w} {
  168.     upvar #0 $w data
  169.  
  170.     frame $w.f3 -border 10
  171.     tixComboBox $w.f3.selection -history true\
  172.     -command "$w invoke" \
  173.     -anchor e \
  174.     -options {
  175.         slistbox.scrollbar auto
  176.         listbox.height 5
  177.         label.anchor w
  178.     }
  179.  
  180.     set data(w:selection) $w.f3.selection
  181.  
  182.     pack $data(w:selection) -side top -fill both
  183.  
  184.     return $w.f3
  185. }
  186.  
  187. #----------------------------------------------------------------------
  188. #                           CONFIG OPTIONS
  189. #----------------------------------------------------------------------
  190. proc tixFileSelectBox::config-directory {w value} {
  191.     upvar #0 $w data
  192.  
  193.     set value [tixFile tildesubst $value]
  194.     set value [tixFile trimslash $value]
  195.  
  196.     tixSetSilent $data(w:filter) \
  197.     [tixFileSelectBox::GetFilter $w $value $data(-pattern)]
  198.  
  199.     $w filter
  200.     set data(-directory) $value
  201.     return $value
  202. }
  203.  
  204. proc tixFileSelectBox::config-pattern {w value} {
  205.     upvar #0 $w data
  206.  
  207.     if {$value == {}} {
  208.     set data(-pattern) "*"
  209.     } else {
  210.     set data(-pattern) $value
  211.     }
  212.     
  213.     tixSetSilent $data(w:filter) \
  214.     [tixFileSelectBox::GetFilter $w $data(-directory) $value]
  215.  
  216.     # Returning a value means we have overridden the value and updated
  217.     # the widget record ourselves.
  218.     #
  219.     return $data(-pattern)
  220. }
  221.  
  222. proc tixFileSelectBox::config-value {w value} {
  223.     upvar #0 $w data
  224.  
  225.     tixSetSilent $data(w:selection) $value
  226. }
  227.  
  228. #----------------------------------------------------------------------
  229. #                    PUBLIC METHODS
  230. #----------------------------------------------------------------------
  231. proc tixFileSelectBox::filter {w args} {
  232.     upvar #0 $w data
  233.  
  234.     $data(w:filter) popdown
  235.     set filter [tixFileSelectBox::InterpFilter $w]
  236.     tixFileSelectBox::LoadDir $w
  237. }
  238.  
  239. # InterpFilter:
  240. #    Interp the value of the w:filter widget. 
  241. #
  242. # Side effects:
  243. #    Changes the fields data(-directory) and data(-pattenn) 
  244. #
  245. proc tixFileSelectBox::InterpFilter {w {filter {}}} {
  246.     upvar #0 $w data
  247.  
  248.     if {$filter == {}} {
  249.     set filter [$data(w:filter) cget -selection]
  250.     if {$filter == {}} {
  251.         set filter [$data(w:filter) cget -value]
  252.     }
  253.     }
  254.  
  255.     set filter [tixFile tildesubst $filter]
  256.     
  257.     if [file isdir $filter] {
  258.     set data(-directory) [tixFile trimslash $filter]
  259.     set data(-pattern) "*"
  260.     } else {
  261.     set data(-directory)  [file dir $filter]
  262.     set data(-pattern)    [file tail $filter]
  263.     }
  264.  
  265.     set data(-directory) [tixResolveDir $data(-directory)]
  266.  
  267.     set filter [tixFileSelectBox::GetFilter $w $data(-directory) \
  268.         $data(-pattern)]
  269.  
  270.     tixSetSilent $data(w:filter) $filter
  271.  
  272.     return $filter
  273. }
  274.  
  275. proc tixFileSelectBox::invoke {w args} {
  276.     upvar #0 $w data
  277.  
  278.     if {[$data(w:selection) cget -value] !=
  279.     [$data(w:selection) cget -selection]} {
  280.         $data(w:selection) invoke
  281.         return
  282.     }
  283.     
  284.     # record the filter
  285.     #
  286.     set filter [tixFileSelectBox::InterpFilter $w]
  287.     $data(w:filter) addhistory $filter
  288.  
  289.     # record the selection
  290.     #
  291.     set value [$data(w:selection) cget -value]
  292.     set value [tixFile tildesubst $value]
  293.     set value [tixFile trimslash $value]
  294.  
  295.     if {[string index $value 0] != "/"} {
  296.     set value $data(-directory)/$value
  297.     set value [tixFile tildesubst $value]
  298.     set value [tixFile trimslash $value]
  299.     tixSetSilent $data(w:selection) $value
  300.     }
  301.     set data(-value) $value
  302.  
  303.     $data(w:selection) addhistory $data(-value)
  304.  
  305.     $data(w:filter) align
  306.     $data(w:selection)  align
  307.  
  308.     if {$data(-command) != {} &&
  309.     ![tixGetBoolean -nocomplain $data(-disablecallback)]} {
  310.     eval $data(-command) [list $data(-value)]
  311.     }
  312. }
  313.  
  314. #----------------------------------------------------------------------
  315. #                    INTERNAL METHODS
  316. #----------------------------------------------------------------------
  317. proc tixFileSelectBox::GetFilter {w dir pattern} {
  318.     if {$dir == "/"} {
  319.     return /$pattern
  320.     } else {
  321.     return $dir/$pattern
  322.     }
  323. }
  324.  
  325. proc tixFileSelectBox::LoadDirIntoLists {w} {
  326.     upvar #0 $w data
  327.  
  328.     $data(w:dirlist) subwidget listbox delete 0 end
  329.     $data(w:filelist) subwidget listbox delete 0 end
  330.  
  331.     set appPWD [pwd]
  332.  
  333.     if [catch {cd $data(-directory)} err] {
  334.     # The user has entered an invalid directory
  335.     # %% todo: prompt error, go back to last succeed directory
  336.     cd $appPWD
  337.     return
  338.     }
  339.  
  340.     foreach fname [lsort [glob -nocomplain * .*]] {
  341.     if {![string compare . $fname]} {
  342.         continue
  343.     }
  344.     if [file isdirectory $data(-directory)/$fname] {
  345.         $data(w:dirlist) subwidget listbox insert end $fname
  346.     }
  347.     }
  348.  
  349.     # force glob to list the .* files. However, since the use might not
  350.     # be interested in them, shift the listbox so that the "normal" files
  351.     # are seen first
  352.     #
  353.     set top 0
  354.     if {$data(-pattern) == "*"} {
  355.     foreach fname [lsort [glob -nocomplain * .*]] {
  356.         if {![file isdirectory $data(-directory)/$fname]} {
  357.         $data(w:filelist) subwidget listbox insert end $fname
  358.         if [string match .* $fname] {
  359.             incr top
  360.         }
  361.         }
  362.     }
  363.     } else {
  364.     foreach fname [lsort [glob -nocomplain $data(-pattern)]] {
  365.         if {![file isdirectory $data(-directory)/$fname]} {
  366.         $data(w:filelist) subwidget listbox insert end $fname
  367.         }
  368.     }
  369.     }
  370.  
  371.     $data(w:filelist) subwidget listbox yview $top
  372.     cd $appPWD
  373. }
  374.  
  375. proc tixFileSelectBox::LoadDir {w} {
  376.     upvar #0 $w data
  377.  
  378.     tixBusy $w on [$data(w:dirlist) subwidget listbox]
  379.  
  380.     catch {
  381.     # This will fail if a directory is not readable .... or some
  382.     # strange reasons
  383.     #
  384.     tixFileSelectBox::LoadDirIntoLists $w
  385.     tixFileSelectBox::MkDirMenu $w
  386.     } err
  387.  
  388.     if {[$data(w:dirlist) subwidget listbox size] == 0} {
  389.     $data(w:dirlist) subwidget listbox insert 0 ".."
  390.     }
  391.  
  392.  
  393.     tixWidgetDoWhenIdle tixBusy $w off [$data(w:dirlist) subwidget listbox]
  394.  
  395. #    if {$err != {}} {
  396. #    error $err
  397. #    }
  398. }
  399.  
  400. # %% unimplemented
  401. #
  402. proc tixFileSelectBox::MkDirMenu {w} {
  403.     upvar #0 $w data
  404. }
  405.  
  406. proc tixFileSelectBox::SelectDir {w} {
  407.     upvar #0 $w data
  408.  
  409.     if {$data(fakeDir) > 0} {
  410.     incr data(fakeDir) -1
  411.     $data(w:dirlist) subwidget listbox select clear 0 end
  412.     return
  413.     }
  414.  
  415.     if {$data(flag)} {
  416.     return
  417.     }
  418.     set data(flag) 1
  419.  
  420.     set subdir [tixListboxGetCurrent [$data(w:dirlist) subwidget listbox]]
  421.     if {$subdir == {}} {
  422.     set subdir "."
  423.     }
  424.  
  425.     set filter \
  426.     [tixFileSelectBox::GetFilter $w $data(-directory) \
  427.          $subdir/$data(-pattern)]
  428.  
  429.     tixSetSilent $data(w:filter) $filter
  430.     
  431.     set data(flag) 0
  432. }
  433.  
  434. proc tixFileSelectBox::InvokeDir {w} {
  435.     upvar #0 $w data
  436.  
  437.     set theDir [$data(w:dirlist) subwidget listbox get active]
  438.  
  439.     set data(-directory) [tixResolveDir $data(-directory)/$theDir]
  440.     $data(w:dirlist) subwidget listbox select clear 0 end
  441.  
  442.     tixFileSelectBox::InterpFilter $w \
  443.     [tixFileSelectBox::GetFilter $w $data(-directory) $data(-pattern)]
  444.  
  445.     tixFileSelectBox::LoadDir $w
  446.  
  447.     incr data(fakeDir) 2
  448. }
  449.  
  450. proc tixFileSelectBox::SelectFile {w} {
  451.     upvar #0 $w data
  452.  
  453.     if {$data(flag)} {
  454.     return
  455.     }
  456.     set data(flag) 1
  457.  
  458.     # Reset the "Filter:" box to the current directory:
  459.     #    
  460.     $data(w:dirlist) subwidget listbox select clear 0 end
  461.     set filter \
  462.     [tixFileSelectBox::GetFilter $w $data(-directory) \
  463.          $data(-pattern)]
  464.  
  465.     tixSetSilent $data(w:filter) $filter
  466.  
  467.     # Now select the file
  468.     #
  469.     set selected [tixListboxGetCurrent [$data(w:filelist) subwidget listbox]]
  470.     if {$selected  != {}} {
  471.     # Make sure that the selection is not empty!
  472.     #
  473.     if {$data(-directory) == "/"} {
  474.         tixSetSilent $data(w:selection) /$selected
  475.         set data(-value) /$selected
  476.     } else {
  477.         tixSetSilent $data(w:selection) $data(-directory)/$selected
  478.         set data(-value) $data(-directory)/$selected
  479.     }
  480.     if {$data(-browsecmd) != {}} {
  481.         eval $data(-browsecmd) [$data(w:selection) cget -value]
  482.     }
  483.     }
  484.     set data(flag) 0
  485. }
  486.  
  487. proc tixFileSelectBox::InvokeFile {w} {
  488.     upvar #0 $w data
  489.  
  490.     set selected [tixListboxGetCurrent [$data(w:filelist) subwidget listbox]]
  491.     if {$selected  != {}} {
  492.     $w invoke
  493.     }
  494. }
  495.  
  496. # This is only called the first this fileBox is mapped -- load the directory
  497. #
  498. proc tixFileSelectBox::FirstMapped {w} {
  499.     if {![winfo exists $w]} {
  500.     return
  501.     }
  502.  
  503.     upvar #0 $w data
  504.  
  505.     tixFileSelectBox::LoadDir $w
  506.     $data(w:filter) align
  507. }
  508.  
  509.  
  510. #----------------------------------------------------------------------
  511. #
  512. #
  513. #              C O N V E N I E N C E   R O U T I N E S 
  514. #
  515. #
  516. #----------------------------------------------------------------------
  517.  
  518. # This is obsolete. Use the widget tixFileSelectDialog instead
  519. #
  520. #
  521. proc tixMkFileDialog {w args} {
  522.     set option(-okcmd)    {}
  523.     set option(-helpcmd)  {}
  524.  
  525.     tixHandleOptions option {-okcmd -helpcmd} $args
  526.  
  527.     toplevel $w
  528.     wm minsize $w 10 10
  529.  
  530.     tixStdDlgBtns $w.btns
  531.     
  532.     if {$option(-okcmd) != {}} {
  533.     tixFileSelectBox $w.fsb -command "wm withdraw $w; $option(-okcmd)"
  534.     } else {
  535.     tixFileSelectBox $w.fsb -command "wm withdraw $w"
  536.     }
  537.  
  538.     $w.btns button ok     config -command "$w.fsb invoke"
  539.     $w.btns button apply  config -command "$w.fsb filter" -text Filter
  540.     $w.btns button cancel config -command "wm withdraw $w"
  541.  
  542.     if {$option(-helpcmd) == {}} {
  543.     $w.btns button help config -state disabled
  544.     } else {
  545.     $w.btns button help config -command $option(-helpcmd)
  546.     }
  547.     wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
  548.     pack $w.btns  -side bottom -fill both
  549.     pack $w.fsb   -fill both -expand yes
  550.  
  551.     return $w.fsb
  552. }
  553.  
  554.  
  555.